home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #11 (Aug 86) / pascal / Rascal source / KeyboardSleuth.src next >
Text File  |  1986-05-23  |  13KB  |  363 lines
  1. program KeyboardSleuth;
  2. (* Keyboard Sleuth: analyze key mappings
  3.    Stand-alone version written in Rascal
  4.    By Joel West, May 1986, for MacTutor
  5.  
  6.    Tries to figure out what keyboard is installed
  7.    Uses several approaches:
  8.         Dump and analyze keyboard #
  9.         Check keypad for Mac 512 vs. Mac Plus
  10.         Look at INTL resources to find for country code
  11.         Check for mapping of space key (US vs. Foreign)
  12.    Then allows user to type keys and shows their keycodes and ASCII values
  13.    Dumps all this to screen and to a logfile
  14.    
  15.    There are two Rascal idiosyncracies that may seem unfamiliar:
  16.         1. Certain reserved entry points (_INIT, _EVENT, _HALT)
  17.            do most of the work.
  18.         2. A few concepts (typing, strings delimiters) are more
  19.            C-like than Pascal-like.       
  20. *)
  21.  
  22. (* Include files and constants *)
  23. (*$U+*)         (* Turn on full Uses *)
  24.     Uses __Windows, __QuickDraw,uToolIntf,uOSIntf,uPackIntf,__PackTraps;
  25.  
  26.     Link __NoSysCall,__PackTraps;    (* Make small stand-alone application *)
  27.  
  28. (* This is to Rascal procedure _EVENT what the first parameter
  29.    of GetNextEvent is to other languages
  30. *)
  31.     EventMask 10;    (* mouseDown(2) + keyDown(8) *)
  32.  
  33.  
  34. CONST
  35.     Key1Trans = $29E;           (* Low Memory Globals *)
  36.     Key2Trans = $2A2;
  37.  
  38.     EOL = 13;                   (* end of line file delimiter (RETURN) *)
  39.  
  40. (********************************* ASCII values **************************)
  41.     Space = $20;                (*   *)
  42.  
  43. (* The following are Key #10, where US,UK "/" is (key # differs in US)
  44.  *)
  45.     Slash = $2F;                (* /    UK      *)
  46.     Minus = $2D;                (* -    German, Spanish, Swedish *)
  47.     Equals = $3D;               (* =    French  *)
  48.     Ograve = $98;               (* ò    Italian *)
  49.     Eaigu = $8E;                (* é    French Canadian *)
  50. (* The following are Key # 36, where UK "`" (accent grave) is
  51.    Used only to distinguish Spanish from German and Swedish
  52.  *)    
  53.     Degree = $A1;               (* °    Spanish/Latin American *)
  54.     Hash = $8A;                 (* #    German   *)
  55.     Apos = $27;                 (* '    Swedish  *)
  56.  
  57. (********************************* Keycap Numbers **************************)
  58.     USspKey = 49;               (* space bar in US *)
  59.     UKspKey = 52;               (* space bar in UK and other Euro-Classics*)
  60.     UKslKey = 10;               (* / key in UK *)
  61.     UKgrKey = 36;               (* ` (dead) key in UK *)
  62.  
  63. VAR
  64.     mywindow: WindowPtr;
  65.     logfile: Integer;           (* type BOOLEAN in Pascal *)
  66.     logname: byte[30];
  67.  
  68. (*************************************BEGIN CODE******************************)
  69. (* Set up a new window *)
  70. Procedure OpenMyWind();
  71.     VAR
  72.         myrect: Rect;
  73.     BEGIN
  74.         GetPort(@mywindow);
  75.         SetRect(myrect,10,40,500,330);
  76.         mywindow := NewWindow(0L, myrect, "Keyboard Sleuth", TRUE,
  77.                               noGrowDocProc, LongInt(-1), TRUE, 0L);
  78.         SetPort(mywindow);
  79.         Move(0,20);             (* skip down a few lines *)
  80.     END;
  81.  
  82. (* This is just glue for the standard register-based Memory Manager
  83.    call of the same name
  84. *)
  85. Procedure BlockMove(src, dest: PtrB; count: LongInt);
  86.     BEGIN
  87.         regcall (Trap $A02E,src,dest,count)
  88.     END;
  89.  
  90. (* Open the log file *)
  91. Procedure OpenLog();
  92.     VAR
  93.         stat: integer;
  94.     BEGIN
  95.         BlockMove("KeyBoard Log", logname, 13L);        (* with length byte *)
  96. (* Some terrible kludges are required to support 4-char
  97.    resource types; (see MacTutor, 5/86, page 53
  98. *)
  99.         fcreate(logname, " MACA"+2, " TEXT"+2, 0);  (* MacWrite text-only *)
  100.         fopen(@logfile, logname, 2, 0);
  101.         fErr(@stat);
  102.         IF stat THEN
  103.             logfile := 0                (* file not opened *)
  104.         ELSE
  105.             fSetEOF(logfile, 0L);       (* set EOF to beginning *)
  106.     END;
  107.  
  108. (* Write a string to the log file and to the screen *)
  109. Procedure PutString(str: PtrB); (* arg is Pascal string *)
  110.     BEGIN
  111.         writestring(str);       (* to the screen *)
  112.         IF logfile THEN
  113.             fPutS(logfile, str);(* to the file *)
  114.     END;
  115.  
  116. (* Write an integer to the log file and to the screen *)
  117. Procedure PutInt(num: Integer);
  118.   VAR
  119.         buff: byte[10];
  120.   BEGIN
  121.         NumToString(LongInt(num), buff);
  122.         PutString(buff);        (* let it do all the work *)
  123.   END;
  124.  
  125. (* Write a new line to the log file and to the screen *)
  126. Procedure PutLine();
  127.   BEGIN
  128.         writeln();
  129.         IF logfile THEN
  130.             fPutC(logfile, EOL);(* Disk files are CR-delimited *)
  131.   END;
  132.  
  133. (* Fetch low memory value indicating the keyboard number *)
  134. Function KbdType(): Integer;
  135.   BEGIN
  136.         KbdType := PtrB($21E)^; (* Just dereference absolute byte ptr *)
  137.   END;
  138.  
  139. (* Translate key number and modifiers to 
  140.    their corresponding ASCII value
  141. *)
  142. Function KeyTrans(keyno,modifies: Integer) : Integer;
  143. (* 
  144.    This tries to call the country-specific keycode translator
  145.    that is loaded in location $29E.  It calls the keypad translator
  146.    at Key2Trans for keycodes >= 64.
  147.    
  148.    Both routines expect the keycode in register d2, and the modifiers
  149.    in the lower bits of register d1; they return an ASCII value in
  150.    register D0
  151. *)    
  152.     VAR
  153.         d1,d2,d0,rtnloc: LongInt;
  154.     BEGIN
  155.         IF keyno < 64 THEN      (* main keyboard *)
  156.             rtnloc := PtrL(Key1Trans)^
  157.         ELSE                    (* auxillary keypad *)
  158.           BEGIN
  159.             rtnloc := PtrL(Key2Trans)^;
  160.             keyno := keyno-64;
  161.           END;
  162.         d2 := keyno;
  163.         d1 := (modifies>>9) and 7;
  164.         d0 := 0;
  165.         push(d1);               (* Push variables onto stack *)
  166.         push(d2);
  167.         pop(Reg D2.L);          (* Pop into corresponding registers *)        
  168.         pop(Reg D1.L);
  169.  
  170. (* The following statement calls the routine whose address is stored
  171.    in variable rtnloc, and then sets the return value (register d0)
  172.    into variable "d0"
  173. *)
  174.         RegCall(Call rtnloc, ,,d0);
  175.         KeyTrans := d0;
  176.     END;
  177.  
  178. (* Show *)
  179. Procedure ShowIntlNation();
  180.     VAR
  181.         country: integer;
  182.         ih: intl0Hndl;
  183.     BEGIN
  184.         ih := intl0Hndl(IUGetIntl(0));          (* get INTL 0 resource *)
  185.         country := (ih^^.intl0Vers) >> 8;       (* country is upper byte *)
  186.  
  187.         PutString("This Mac is configured for ");
  188.  
  189. (* There are a number of symbolic constants for these (verUS, verFrance, etc.),
  190.    but if your have the latest update to your development system, you
  191.    probably won't have all 26.  I've hard-coded them for clarity.
  192. *)
  193.        CASE country OF
  194.            0:   PutString("the US or Canada"); 
  195.            1:   PutString("France"); 
  196.            2:   PutString("U.K. or Ireland"); 
  197.            3:   PutString("Deutschland");       (* Germany *)
  198.            4:   PutString("Italia"); 
  199.            5:   PutString("Nederland");         (* Netherlands *)
  200.            6:   PutString("Belgique ou Luxembourg"); 
  201.            7:   PutString("Sverige");           (* Sweden *)
  202.            8:   PutString("Españá");            (* Spain *)
  203.            9:   PutString("Danmark"); 
  204.           10:   PutString("Portugal"); 
  205.           11:   PutString("Quebec");            (* French Canada *)
  206.           12:   PutString("Norge");             (* Norway *)
  207.           13:   PutString("Yisra’el"); 
  208.           14:   PutString("Nippon");            (* Japan *)
  209.           15:   PutString("Australia or New Zealand"); 
  210.           16:   PutString("Arabiyah"); 
  211.           17:   PutString("Suomi");             (* Finland *)
  212.           18:   PutString("Suisse");            (* French Swiss *)
  213.           19:   PutString("Schweiz");           (* German Swiss *)
  214.           20:   PutString("Ellas");             (* Greece *)
  215.           21:   PutString("Island");            (* Iceland *)
  216.           22:   PutString("Malta"); 
  217.           23:   PutString("Kypros");            (* Cyprus *) 
  218.           24:   PutString("Türkiye"); 
  219.           25:   PutString("Jugoslavija"); 
  220.           OTHERWISE
  221.             BEGIN
  222.               PutString("an unknown country, #");
  223.               PutInt(country);
  224.             END;
  225.         END;
  226.  
  227.         PutString(".");
  228.         PutLine();
  229.         PutLine();
  230.     END;
  231.  
  232. (* Guess which type of Macintosh keyboard *)
  233. Procedure ShowModel();
  234.     BEGIN
  235. (* Use derived keyboard numbers *)
  236.  
  237.         PutString("The keyboard type is ");
  238.         PutInt(KbdType());
  239.  
  240.         CASE KbdType() OF
  241.           11: 
  242.             PutString(", which is a Mac Plus keyboard.");
  243.           3:
  244.             PutString(", which is the Classic Mac keyboard.");
  245.           OTHERWISE
  246.             PutString(", which is unknown.");
  247.         END;
  248.  
  249.         PutLine();
  250.     END;
  251.  
  252. (* Guess which country keyboard mappings are set for  *)
  253. Procedure GuessKeyNation();
  254.     BEGIN
  255. (* Try mapping of certain keys to figure US vs. non-US keyboard *)
  256.         IF (KeyTrans(USspKey,0) = Space) THEN
  257.             PutString("This is US, Canadian or down under.")
  258.         ELSE
  259.             IF (KeyTrans(UKspKey,0) = Space) THEN
  260.               BEGIN
  261. (* Use UK "/" key to guess at nationality *)
  262.                 CASE KeyTrans(UKslKey,0) OF
  263.                     Slash:              (* /    UK      *) 
  264.                         PutString("I am British or Dutch.");
  265.                     Ograve:             (* ò    Italian *)
  266.                         PutString("Sono Italiano.");
  267.                     Equals:             (* =    French  *)
  268.                         PutString("Je suis français, suisse ou belge.");
  269.                     Eaigu:              (* é    French Canadian *)
  270.                         PutString("Je suis canadien.");
  271.                     Minus:              (* -    German, Spanish, Swedish  *)
  272. (* Use UK accent grave (dead `) to tell German, Spanish, and Swedish *)
  273.                         CASE KeyTrans(UKgrKey,0) OF
  274.                             Hash:       (* #    German   *)
  275.                                 PutString("Ich bin ein Deutscher.");
  276.                             Degree:     (* ç    Spanish  *)
  277.                                 PutString("Habla Español.");
  278.                             Apos:       (* '    Swedish   *)
  279.                                 PutString("This is Swedish.");
  280.                             otherwise   (* I have no country! *)
  281.                                 PutString("¡No tengo un país!");
  282.                         END;
  283.                    OTHERWISE
  284.                         PutString("I am a Mac without a country!");
  285.                 END;
  286.               END
  287.           ELSE
  288.               PutString("Neither US nor European, what is it?");
  289.         PutLine();
  290.     END;
  291.  
  292. (* Rascal calls this routine once on initialization *)
  293. Procedure _INIT();
  294.     BEGIN
  295.         OpenMyWind();           (* display window *)
  296.         OpenLog();              (* log file *)
  297.  
  298.         ShowIntlNation();       (* Find country code *)
  299.         ShowModel();            (* Examine keyboard type *)
  300.  
  301.         GuessKeyNation();       (* Look at key mappings *)
  302.  
  303.         PutLine();
  304.         PutLine();
  305.         PutString("Type keys, or click mouse to quit.");
  306.         PutLine();
  307.     END;        
  308.         
  309.  
  310. (* Rascal calls this routine for each event posted
  311.    Come here for key down (debug decoding)
  312.    or mouse down (time to quit)
  313. *)
  314. Procedure _EVENT(myevr: EventRecord);
  315.     VAR
  316.         keyc,mods,asc: Integer;
  317.         buff : byte[2];
  318.     BEGIN
  319.         buff[0] := 1;           (* set 1-char Pascal string buffer *)  
  320.         SetPort(mywindow);
  321.         CASE myevr.what OF
  322.             mouseDown:
  323.               reqhalt();        (* Calls _HALT implicitly *)
  324.             keyDown:
  325.               BEGIN
  326. (* Isolate keycode and modifiers *)
  327.                 keyc := (myevr.message and keyCodeMask)>>8;
  328.                 mods := myevr.modifiers;
  329.                 PutString("Key #");
  330.                 PutInt(keyc);
  331.                 IF mods and optionKey THEN
  332.                     PutString(" with Option");
  333.                 IF mods and shiftKey THEN
  334.                     PutString(", shifted");
  335.                 IF mods and alphaLock THEN
  336.                     PutString(", Caps Locked");
  337.                 asc := KeyTrans(keyc,mods);     (* translate to ASCII *)
  338. (* Don't want to print control characters *)
  339.                 IF asc >= 32 THEN
  340.                 BEGIN                
  341.                     PutString(" is ");
  342.                     buff[1] := asc;             (* stuff char in temp string *)
  343.                     PutString(buff);            (* put char *)
  344.                     PutString(" (ascii ");
  345.                     PutInt(asc);
  346.                     PutString(").");
  347.                 END;
  348.                 PutLine();
  349.               END;
  350.         END;
  351.     END;
  352.  
  353. (* Called by Rascal when done *)
  354. Procedure _HALT();
  355.     BEGIN  
  356.         DisposeWindow(mywindow);
  357.         IF logfile THEN
  358.             fclose(logfile);
  359. (* From here, Rascal automatically exits to the Rascal environment,
  360.    or ExitToShell if a stand-alone application is built
  361. *)
  362.     END;
  363.